MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 05 - 1989/05.01 Jan 89/FinderControls/MPOP texte

Text File | 1988-04-26 | 11.6 KB | 430 lines | [TEXT/PJMM]

{**********************************************}
{ Put this file in the MPOP Project after DAPasLib. }
{ Don't put MacTraps that would generate unusefull glue for the Memory Manager. }
{ I prefer to declare DisposHandle as inline procedure : see below. }
{ Don't forget to "Use resource file" in "Run options" of menu "Project". }
{ This resource file must contain the MENU and ICN# resources }
{ that the PopTrap Project needs together with the compiled MDEF resource. }

{ "Build and save as…" resource code of type MDEF and ID 128 in file "MPOP code" }
{**********************************************}
UNIT MPOP;

INTERFACE

{ the name "Main" indicates to LightSpeed Pascal compiler where the entry point is }
    PROCEDURE Main (message : integer;
                                    theMenu : MenuHandle;
                                    VAR menuRect : rect;
                                    hitPt : point;
                                    VAR whichItem : integer);

IMPLEMENTATION

    CONST
        mPopUpMsg = 3;        { and not 4 as written in early versions of new MenuMgr }

    PROCEDURE CopyMask (srcBits, maskBits, dstBits : BitMap;
                                    srcRect, maskRect, dstRect : Rect);
    INLINE
        $A817;

    PROCEDURE DisposHandle (h : handle);
{ to avoid putting the whole Memory Manager glue in our code resource  }
    INLINE
        $205F, $A023, $31C0, $0220;

{***************************************}

{ first some utilities for reading MENU resources : }

    FUNCTION GetNextByte (VAR LongAddress : longint) : byte;
    INLINE
        $205F,    { MOVEA.L    (A7)+,A0     }
        $2250,    { MOVEA.L    (A0),A1     }
        $5290,    { ADDQ.L     #$1,(A0)     }
        $204F,    { MOVEA.L    A7,A0         }
        $4218,    { CLR.B      (A0)+         }
        $1091;    { MOVE.B     (A1),(A0)     }

    FUNCTION GetNextInteger (VAR LongAddress : longint) : integer;
    INLINE
        $205F,    { MOVEA.L    (A7)+,A0         }
        $2250,    { MOVEA.L    (A0),A1         }
        $5490,    { ADDQ.L     #$2,(A0)         }
        $204F,    { MOVEA.L   A7,A0             }
        $10D9,    { MOVE.B     (A1)+,(A0)+    }
        $1091;    { MOVE.B     (A1),(A0)         }

    FUNCTION GetNextString (VAR LongAddress : longint) : StringHandle;
{ returns NIL if allocation failed }
    INLINE
        $205F,                { MOVEA.L    (A7)+,A0        ;A0:=@LongAddress }
        $2250,                { MOVEA.L    (A0),A1        ;A1:=LongAddress }
        $7000,                { MOVEQ      #$00,D0        ;countChars:=0 }
        $1011,                { MOVE.B     (A1),D0            ;countChars:=LongAddress^ }
        $2200,                { MOVE.L     D0,D1            ;save countChars }
        $5200,                { ADDQ.B     #$1,D0            ;length:=countChars+1 }
        $D190,                { ADD.L      D0,(A0)            ;FuturLongAddress:=LongAddress+length }
        $A122,                { OSTRAP     $A122            ;A0:=NewHandle(D0=length) }
        $4A80,                { TST.L      D0                    ;if MemError }
        $660C,                { BNE.S      *+$000E            ;<>0 goto error }
        $2E88,                { MOVE.L     A0,(A7)            ;GetChaine:=A0 }
        $2050,                { MOVEA.L    (A0),A0        ;StringPtr }
                        { loop                                ;repeat }
        $10D9,                { MOVE.B     (A1)+,(A0)+    ;StringPtr^:=LongAddress^ }
        $51C9, $FFFC,        { DBF        D1,*-$0002        ;dec(length); until length<0 }
        $6002,                { BRA.S      *+$0004        ;goto bottom }
                        { error }
        $4297;                { CLR.L      (A7)                ;GetChaine:=NIL }
                        { bottom }

    FUNCTION SkipNextString (VAR LongAddress : longint) : byte;
        VAR
            length : byte;
    BEGIN
        length := GetNextByte(LongAddress);
        LongAddress := LongAddress + length;
        SkipNextString := length;
    END;

    PROCEDURE SkipBytes (VAR LongAddress : longint;
                                    byteCount : integer);
    BEGIN
        LongAddress := LongAddress + byteCount;
    END;

{***************************************}

    PROCEDURE Main;

        FUNCTION GetItemCenter : point;
{ returns the ItemCenter in local coordinates, relative to menuRect }
{ theMenu is allready locked }
            VAR
                LongAddress : longint;
                length : byte;
                i : integer;
                ItemCenter : point;
        BEGIN
            LongAddress := ord(theMenu^) + 14;
            length := SkipNextString(LongAddress);
            i := 0;
            REPEAT
                i := i + 1;
                length := SkipNextString(LongAddress);
                IF length > 0 THEN
                    BEGIN
                        IF i = whichItem THEN
                            BEGIN
                                ItemCenter.v := GetNextInteger(LongAddress);
                                ItemCenter.h := GetNextInteger(LongAddress);
                            END
                        ELSE
                            BEGIN
                                SkipBytes(LongAddress, 4);
                            END;
                    END
                ELSE        { if length<=0 : }
                    SetPt(ItemCenter, 0, 0);
            UNTIL (length <= 0) OR (i = whichItem);
            GetItemCenter := ItemCenter;
        END;

{***************************************}

        PROCEDURE DoDrawMessage;

            PROCEDURE PinString (theString : Str255;
                                            center : point);
            BEGIN
                WITH center DO
                    MoveTo(h - StringWidth(theString) DIV 2, v);
                DrawString(theString);
            END;

            PROCEDURE PlotIconDataCopy (theIcon : handle;
                                            dstSquare : rect);
                VAR
                    srcSquare : rect;
                    data : bitmap;
                    myPort : GrafPtr;
            BEGIN
                IF (theIcon <> NIL) THEN
                    BEGIN
                        SetRect(srcSquare, -16, -16, 16, 16);
                        data.rowBytes := 4;
                        data.baseAddr := ptr(theIcon^);
                        data.bounds := srcSquare;
                        GetPort(myPort);
                        CopyBits(data, myPort^.portbits, srcSquare, dstSquare, srcCopy, NIL);
                    END;
            END;

            VAR
                IconRect : rect;
                IconName : StringHandle;
                LongAddress : longint;
                NameLength : byte;
                ItemCenter, TextCenter : point;
                theIcon : handle;
        BEGIN
            LongAddress := ord(theMenu^) + 14;
            NameLength := SkipNextString(LongAddress);
            REPEAT
                IconName := GetNextString(LongAddress);
                NameLength := length(IconName^^);
                IF NameLength > 0 THEN
                    BEGIN
                        theIcon := GetNamedResource('ICN#', IconName^^);
                        ItemCenter.v := GetNextInteger(LongAddress) + menuRect.top;
                        ItemCenter.h := GetNextInteger(LongAddress) + menuRect.left;
                        WITH ItemCenter DO
                            BEGIN
                                SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
                                SetPt(TextCenter, h, v + 20);
                            END;
                        PlotIconDataCopy(theIcon, IconRect);
                        TextFont(geneva);
                        TextSize(9);
                        PinString(IconName^^, TextCenter);
                        TextFont(systemFont);
                        TextSize(12);
                    END;
                DisposHandle(handle(IconName));
            UNTIL NameLength <= 0;
        END;                { of DoDrawMessage }

{***************************************}

        PROCEDURE DoChooseMessage;

            FUNCTION GetIconRect : rect;
{ returns the IconRect in global coordinates }
                VAR
                    ItemCenter : point;
                    IconRect : rect;
            BEGIN
                ItemCenter := GetItemCenter;
                WITH ItemCenter DO
                    BEGIN
                        IF (h = 0) AND (v = 0) THEN
                            SetRect(IconRect, 0, 0, 0, 0)
                        ELSE
                            SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
                    END;
                WITH menuRect DO
                    OffSetRect(IconRect, left, top);
                GetIconRect := IconRect;
            END;            { of GetIconRect }

            PROCEDURE PlotIconMaskXor (theIcon : handle;
                                            dstSquare : rect);
                VAR
                    srcSquare : rect;
                    mask : bitmap;
                    myPort : GrafPtr;
            BEGIN
                IF (theIcon <> NIL) THEN
                    BEGIN
                        SetRect(srcSquare, -16, -16, 16, 16);
                        mask.rowBytes := 4;
                        mask.baseAddr := ptr(ord4(theIcon^) + 128);
                        mask.bounds := srcSquare;
                        GetPort(myPort);
                        CopyBits(mask, myPort^.portbits, srcSquare, dstSquare, srcXOr, NIL);
                    END;
            END;                { of PlotIconMaskXor }

            FUNCTION GetIconName (whichItem : integer) : StringHandle;
{ theMenu is allready locked }
                VAR
                    LongAddress : longint;
                    length : byte;
                    i : integer;
                    IconName : StringHandle;
            BEGIN
                LongAddress := ord(theMenu^) + 14;
                length := SkipNextString(LongAddress);
                i := 0;
                REPEAT
                    i := i + 1;
                    IF i = whichItem THEN
                        BEGIN
                            IconName := GetNextString(LongAddress);
                        END
                    ELSE
                        BEGIN
                            length := SkipNextString(LongAddress);
                            IF length > 0 THEN
                                SkipBytes(LongAddress, 4)
                            ELSE
                                IconName := NIL;
                        END;
                UNTIL (length <= 0) OR (i = whichItem);
                GetIconName := IconName;
            END;

            PROCEDURE InvertIcon (whichItem : integer;
                                            dstSquare : rect);
                VAR
                    IconName : StringHandle;
                    myIcon : handle;
            BEGIN
                IconName := GetIconName(whichItem);
                myIcon := GetNamedResource('ICN#', IconName^^);
                PlotIconMaskXor(myIcon, dstSquare);
            END;

            VAR
                itemNumber : integer;
                NameLength : byte;
                LongAddress : longint;
                ItemCenter : point;
                ItemRect, OldIconRect, IconRect : rect;
        BEGIN                { DoChooseMessage }
            LongAddress := ord(theMenu^) + 14;
            NameLength := SkipNextString(LongAddress);
            itemNumber := 0;
            REPEAT
                itemNumber := itemNumber + 1;
                NameLength := SkipNextString(LongAddress);
                IF NameLength > 0 THEN
                    BEGIN
                        ItemCenter.v := GetNextInteger(LongAddress);
                        ItemCenter.h := GetNextInteger(LongAddress);
                        WITH ItemCenter DO
                            SetRect(ItemRect, h - 25, v - 25, h + 25, v + 25);
                        WITH menuRect DO
                            OffSetRect(ItemRect, left, top);
                    END;
            UNTIL (NameLength <= 0) OR (PtInRect(hitPt, ItemRect));
            IF NameLength <= 0 THEN        { hitPt is not in any item }
                BEGIN
                    IF whichItem <> 0 THEN
                        BEGIN
                            InvertIcon(whichItem, GetIconRect);
                            whichItem := 0;
                        END;
                END
            ELSE IF itemNumber <> whichItem THEN                            { hitPt is in itemRect }
                BEGIN
                    IF whichItem <> 0 THEN
                        InvertIcon(whichItem, GetIconRect);
                    WITH ItemCenter DO
                        SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
                    WITH MenuRect DO
                        OffSetRect(IconRect, left, top);
                    InvertIcon(itemNumber, IconRect);
                    whichItem := itemNumber;
                END;
        END;                { of DoChooseMessage }

{***************************************}

        PROCEDURE DoSizeMessage;
{ theMenu is allready locked }

            PROCEDURE RectAndPt (VAR theRect : rect;
                                            thePoint : point);
            BEGIN
                WITH theRect, thePoint DO
{ we suppose that 0=left<right and 0=top<bottom }
                    BEGIN
                        IF h > right THEN
                            right := h;
                        IF v > bottom THEN
                            bottom := v;
                    END;
            END;

            VAR
                LongAddress : longint;
                length : byte;
                ItemCenter : point;
                Envelope : rect;
        BEGIN
            LongAddress := ord(theMenu^) + 14;
            length := SkipNextString(LongAddress);
            SetRect(Envelope, 0, 0, 0, 0);
            REPEAT
                length := SkipNextString(LongAddress);
                IF length > 0 THEN
                    BEGIN
                        ItemCenter.v := GetNextInteger(LongAddress);
                        ItemCenter.h := GetNextInteger(LongAddress);
                        RectAndPt(envelope, ItemCenter);
                    END
            UNTIL (length <= 0);
            WITH theMenu^^, envelope DO
                BEGIN
                    menuWidth := right + 25;
                    menuHeight := bottom + 25;
                END;
        END;            { of DoSizeMessage }

{***************************************}

        PROCEDURE DoPopUpMessage;
{ on entry:        whichItem(=popUpItem) , }
{                    hitPt (= center of title icon) }
{                    theMenu (Locked) }
{ on exit : menuRect }
{ ThePort is allready set to WindowManager Port }
            VAR
                ItemCenter, IconCenter : point;
                dh, dv : integer;
                WMPort : GrafPtr;
                mBarHeight : ^integer;
        BEGIN
            mBarHeight := pointer($BAA);
            WITH theMenu^^, hitPt DO
                SetRect(menuRect, h, v, h + menuWidth, v + MenuHeight);
            IF whichItem > 0 THEN
                BEGIN
                    ItemCenter := GetItemCenter;
                    WITH ItemCenter DO
                        SetPt(IconCenter, h, v - 5);
                    WITH IconCenter DO
                        IF NOT ((h = 0) AND (v = 0)) THEN
                            OffSetRect(menuRect, -h, -v)
                        ELSE
                            whichItem := 0;
                END;
            IF whichItem <= 0 THEN
                OffSetRect(menuRect, -25, +25);
            GetPort(WMPort);
            WITH WMPort^ DO
                BEGIN
                    IF menuRect.right + 8 > PortRect.right THEN
                        dh := PortRect.right - menuRect.right - 8
                    ELSE IF menuRect.left - 8 < PortRect.left THEN
                        dh := PortRect.left - menuRect.left + 8
                    ELSE
                        dh := 0;
                    IF menuRect.bottom + 8 > PortRect.bottom THEN
                        dv := PortRect.bottom - menuRect.bottom - 8
                    ELSE IF menuRect.top - 8 < PortRect.top + mBarHeight^ THEN
                        dv := PortRect.top + mBarHeight^ - menuRect.top + 8
                    ELSE
                        dv := 0;
                END;
            OffSetRect(menuRect, dh, dv);
        END;                { of DoPopUpMessage }

{***************************************}

    BEGIN                { of Main }
        CASE message OF
            mSizeMsg :
                DoSizeMessage;
            mDrawMsg :
                DoDrawMessage;
            mChooseMsg :
                DoChooseMessage;
            mPopUpMsg :
                DoPopUpMessage;
        END;
    END;

END.